
(*$U-*)
PROGRAM PASCALSYSTEM;

(************************************************)
(*                                              *)
(*        UCSD  PASCAL  COMPILER                *)
(*                                              *)
(*    BASED ON ZURICH P2 PORTABLE               *)
(*    COMPILER, EXTENSIVLY                      *)
(*    MODIFIED BY ROGER T. SUMNER               *)
(*    1976..1977                                *)
(*                                              *)
(*    INSTITUTE FOR INFORMATION SYSTEMS         *)
(*    UC SAN DIEGO, LA JOLLA, CA                *)
(*                                              *)
(*    KENNETH L. BOWLES, DIRECTOR               *)
(*                                              *)
(*    THIS SOFTWARE IS THE PROPERTY OF THE      *)
(*  REGENTS OF THE UNIVERSITY OF CALIFORNIA.    *)
(*                                              *)
(************************************************)

TYPE PHYLE = FILE;
     INFOREC = RECORD
		 WORKSYM,WORKCODE: ^PHYLE;
		 ERRSYM,ERRBLK,ERRNUM: INTEGER;
		 STUPID: BOOLEAN
	       END;

PROGRAM PROCEDURE USERPROGRAM;
BEGIN END (*USERPROGRAM*) ;

PROGRAM PROCEDURE COMPILER(VAR USERINFO: INFOREC);

CONST DISPLIMIT = 12; MAXLEVEL = 8; MAXADDR = 28000;
      INTSIZE = 1; REALSIZE = 2; BITSPERWD = 16;
      CHARSIZE = 1; BOOLSIZE = 1; PTRSIZE = 1;
      FILESIZE = 300; NILFILESIZE = 34; BITSPERCHR = 8; CHRSPERWD = 2;
      STRINGSIZE = 0; STRGLGTH = 255; MAXINT = 32767;
      DEFSTRGLGTH = 80; LCAFTERMARKSTACK = 1;
      EOL = 13; MAXCURSOR = 1023; MAXCODE = 1299;
      MAXJTAB = 24; MAXSEG = 15; MAXPROCNUM = 149;

TYPE
					      (*BASIC SYMBOLS*)

     SYMBOL =  (IDENT,COMMA,COLON,SEMICOLON,LPARENT,RPARENT,DOSY,TOSY,
		DOWNTOSY,ENDSY,UNTILSY,OFSY,THENSY,ELSESY,BECOMES,LBRACK,
		RBRACK,ARROW,PERIOD,BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,
		FORSY,WITHSY,GOTOSY,LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,
		FUNCSY,PROGSY,FORWARDSY,INTCONST,REALCONST,STRINGCONST,
		NOTSY,MULOP,ADDOP,RELOP,SETSY,PACKEDSY,ARRAYSY,RECORDSY,
		FILESY,OTHERSY);


     OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,
		 GEOP,GTOP,NEOP,EQOP,INOP,NOOP);

     SETOFSYS = SET OF SYMBOL;

					      (*CONSTANTS*)
     CSTCLASS = (REEL,PSET,STRG,TRIX);
     CSP = ^ CONSTREC;
     CONSTREC = RECORD CASE CCLASS: CSTCLASS OF
			 TRIX: (CSTVAL: ARRAY [1..8] OF INTEGER);
			 REEL: (RVAL: REAL);
			 PSET: (PVAL: SET OF 0..127);
			 STRG: (SLGTH: 0..STRGLGTH;
				SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR)
		       END;

     VALU = RECORD CASE BOOLEAN OF
		     TRUE:  (IVAL: INTEGER);
		     FALSE: (VALP: CSP)
		   END;

						  (*DATA STRUCTURES*)
     BITRANGE = 0..BITSPERWD; OPRANGE = 0..80;
     CURSRANGE = 0..MAXCURSOR; PROCRANGE = 0..MAXPROCNUM;
     LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR;
     JTABRANGE = 0..MAXJTAB; SEGRANGE = 0..MAXSEG;
     DISPRANGE = 0..DISPLIMIT;

     STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,
		   RECORDS,FILES,TAGFLD,VARIANT);

     DECLKIND = (STANDARD,DECLARED,SPECIAL);

     STP = ^ STRUCTURE; CTP = ^ IDENTIFIER;

     STRUCTURE = RECORD
		   SIZE: ADDRRANGE;
		   CASE FORM: STRUCTFORM OF
		     SCALAR:   (CASE SCALKIND: DECLKIND OF
				  DECLARED: (FCONST: CTP));
		     SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU);
		     POINTER:  (ELTYPE: STP);
		     POWER:    (ELSET: STP);
		     ARRAYS:   (AELTYPE,INXTYPE: STP;
				CASE AISPACKD:BOOLEAN OF
				  TRUE: (ELSPERWD,ELWIDTH: BITRANGE;
					 CASE AISSTRNG: BOOLEAN OF
					  TRUE:(MAXLENG: 1..STRGLGTH)));
		     RECORDS:  (FSTFLD: CTP; RECVAR: STP);
		     FILES:    (FILTYPE: STP);
		     TAGFLD:   (TAGFIELDP: CTP; FSTVAR: STP);
		     VARIANT:  (NXTVAR,SUBVAR: STP; VARVAL: VALU)
		   END;

							    (*NAMES*)
     IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC);
     SETOFIDS = SET OF IDCLASS;
     IDKIND = (ACTUAL,FORMAL);
     ALPHA = PACKED ARRAY [1..8] OF CHAR;

     IDENTIFIER = RECORD
		   NAME: ALPHA; LLINK, RLINK: CTP;
		   IDTYPE: STP; NEXT: CTP;
		   CASE KLASS: IDCLASS OF
		     KONST: (VALUES: VALU);
		     VARS:  (VKIND: IDKIND; VLEV: LEVRANGE;
			     VADDR: ADDRRANGE);
		     FIELD: (FLDADDR: ADDRRANGE;
			     CASE FISPACKD: BOOLEAN OF
			       TRUE: (FLDRBIT,FLDWIDTH: BITRANGE));
		     PROC,
		     FUNC:  (CASE PFDECKIND: DECLKIND OF
			      SPECIAL:  (KEY: 1..23);
			      STANDARD: (CSPNUM: 1..40);
			      DECLARED: (PFLEV: LEVRANGE;
					 PFNAME: PROCRANGE;
					 PFSEG: SEGRANGE;
					 CASE PFKIND: IDKIND OF
					   ACTUAL: (LOCALLC: ADDRRANGE;
						    FORWDECL,
						    INSCOPE: BOOLEAN)))
		   END;


     WHERE = (BLCK,CREC,VREC,REC);

					      (*EXPRESSIONS*)
     ATTRKIND = (CST,VARBL,EXPR);
     VACCESS = (DRCT,INDRCT,PACKD,MULTI,BYTE);

     ATTR = RECORD TYPTR: STP;
	      CASE KIND: ATTRKIND OF
		CST:   (CVAL: VALU);
		VARBL: (CASE ACCESS: VACCESS OF
			  DRCT:   (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE);
			  INDRCT: (IDPLMT: ADDRRANGE))
	    END;

     TESTP = ^ TESTPOINTER;
     TESTPOINTER = RECORD
		     ELT1,ELT2 : STP;
		     LASTTESTP : TESTP
		   END;

						   (*LABELS*)
     LBP = ^ CODELABEL;
     CODELABEL = RECORD
		   CASE DEFINED: BOOLEAN OF
		     FALSE: (REFLIST: ADDRRANGE);
		     TRUE:  (OCCURIC: ADDRRANGE; JTABINX: JTABRANGE)
		 END;

     LABELP = ^ USERLABEL;
     USERLABEL = RECORD
		   LABVAL: INTEGER;
		   NEXTLAB: LABELP;
		   CODELBP: LBP
		 END;

     CODEARRAY = PACKED ARRAY [0..MAXCODE] OF CHAR;
     SYMBUFARRAY = PACKED ARRAY [CURSRANGE] OF CHAR;

(*--------------------------------------------------------------------*)

VAR

    CODEP: ^ CODEARRAY;             (*CODE BUFFER UNTIL WRITEOUT*)
    SYMBUFP: ^ SYMBUFARRAY;         (*SYMBOLIC BUFFER...ASCII OR CODED*)

    GATTR: ATTR;                    (*DESCRIBES CURRENT EXPRESSION*)
    VAL: VALU;                      (*VALUE OF LAST CONSTANT*)

    DISX,                           (*LEVEL OF LAST ID SEARCHED*)
    TOP: DISPRANGE;                 (*TOP OF DISPLAY*)
				    (*SCANNER GLOBALS...NEXT FOUR VARS*)
				    (*MUST BE IN THIS ORDER FOR IDSEARCH*)
    SYMCURSOR: CURSRANGE;           (*CURRENT SCANNING INDEX IN SYMBUFP^*)
    SY: SYMBOL;                     (*SYMBOL FOUND BY INSYMBOL*)
    OP: OPERATOR;                   (*CLASSIFICATION OF LAST SYMBOL*)
    ID: ALPHA;                      (*LAST IDENTIFIER FOUND*)

    LGTH: INTEGER;                  (*LENGTH OF LAST STRING CONSTANT*)

    LCMAX,LC,IC: ADDRRANGE;         (*LOCATION AND INSTRUCT COUNTERS*)

				    (*SWITCHES:*)

    PRTERR,GOTOOK,RANGECHECK,CODEINSEG,IOCHECK,
    LIST,TEST,SYSCOMP,DP,INCLUDING: BOOLEAN;

				    (*POINTERS:*)
    INTPTR,REALPTR,CHARPTR,BOOLPTR,
    TEXTPTR,NILPTR,STRGPTR: STP;    (*POINTERS TO STANDARD IDS*)

    UTYPPTR,UCSTPTR,UVARPTR,
    UFLDPTR,UPRCPTR,UFCTPTR,        (*POINTERS TO UNDECLARED IDS*)
    INPUTPTR,OUTPUTPTR,
    OUTERBLOCK,FWPTR: CTP;

    GLOBTESTP: TESTP;                (*LAST TESTPOINTER*)

    LEVEL: LEVRANGE;                (*CURRENT STATIC LEVEL*)

    SEG,NEXTSEG: SEGRANGE;          (*CURRENT SEGMENT #*)
    SEGINX: INTEGER;                (*CURRENT INDEX IN SEGMENT*)
    SCONST: CSP;                    (*INSYMBOL STRING RESULTS*)

    LOWTIME,LINEINFO,SCREENDOTS,STARTDOTS,SYMBLK: INTEGER;
    LINESTART: CURSRANGE;

    CURPROC,NEXTPROC: PROCRANGE;     (*PROCEDURE NUMBER ASSIGNMENT*)

    CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,
    SELECTSYS,FACBEGSYS,STATBEGSYS,TYPEDELS: SETOFSYS;

    DISPLAY: ARRAY [DISPRANGE] OF
		RECORD
		  FNAME: CTP;
		  CASE OCCUR: WHERE OF
		    BLCK: (FFILE: CTP; FLABEL: LABELP);
		    CREC: (CLEV: LEVRANGE; CDSPL: ADDRRANGE);
		    VREC: (VDSPL: ADDRRANGE)
		  END;

    PROCTABLE: ARRAY [PROCRANGE] OF INTEGER;

    SEGTABLE: ARRAY [SEGRANGE] OF
		RECORD
		  DISKADDR,CODELENG: INTEGER;
		  SEGNAME: ALPHA
		END (*SEGTABLE*) ;

    NEXTJTAB: JTABRANGE;
    JTAB: ARRAY [JTABRANGE] OF INTEGER;

    OLDSYMBLK: INTEGER;
    OLDSYMCURSOR: CURSRANGE;
    INCLFILE: FILE;

    CURBYTE, CURBLK: INTEGER;
    DISKBUF: PACKED ARRAY [0..511] OF CHAR;

(*--------------------------------------------------------------------*)

PROCEDURE INSYMBOL;
  FORWARD;

PROCEDURE ERROR(ERRORNUM: INTEGER);
  FORWARD;

PROCEDURE ENTERID(FCP: CTP);
  FORWARD;

PROCEDURE GETNEXTPAGE;
  FORWARD;

PROGRAM PROCEDURE COMPINIT;

  PROCEDURE ENTSTDTYPES;
    VAR SP: STP;
  BEGIN
    NEW(INTPTR,SCALAR,STANDARD);
    WITH INTPTR^ DO
      BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(REALPTR,SCALAR,STANDARD);
    WITH REALPTR^ DO
      BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(CHARPTR,SCALAR,STANDARD);
    WITH CHARPTR^ DO
      BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(BOOLPTR,SCALAR,DECLARED);
    WITH BOOLPTR^ DO
      BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END;
    NEW(NILPTR,POINTER);
    WITH NILPTR^ DO
      BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE := NIL END;
    NEW(TEXTPTR,FILES);
    WITH TEXTPTR^ DO
      BEGIN SIZE := FILESIZE+CHARSIZE; FORM := FILES; FILTYPE := CHARPTR END;
    NEW(STRGPTR,ARRAYS,TRUE,TRUE);
    WITH STRGPTR^ DO
      BEGIN FORM := ARRAYS; SIZE := (DEFSTRGLGTH + CHRSPERWD) DIV CHRSPERWD;
	AISPACKD := TRUE; AISSTRNG := TRUE; INXTYPE := INTPTR;
	ELWIDTH := BITSPERCHR; ELSPERWD := CHRSPERWD;
	AELTYPE := CHARPTR; MAXLENG := DEFSTRGLGTH;
      END
  END (*ENTSTDTYPES*) ;

  PROCEDURE ENTSTDNAMES;
    VAR CP,CP1: CTP; I: INTEGER;
  BEGIN
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN NAME := 'REAL    '; IDTYPE := REALPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN NAME := 'CHAR    '; IDTYPE := CHARPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN NAME := 'BOOLEAN '; IDTYPE := BOOLPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN NAME := 'STRING  '; IDTYPE := STRGPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN NAME := 'TEXT    '; IDTYPE := TEXTPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(INPUTPTR,VARS);
    WITH INPUTPTR^ DO
      BEGIN NAME := 'INPUT   '; IDTYPE := TEXTPTR; KLASS := VARS;
	VKIND := FORMAL; VLEV := 0; VADDR := 2
      END;
    ENTERID(INPUTPTR);
    NEW(OUTPUTPTR,VARS);
    WITH OUTPUTPTR^ DO
      BEGIN NAME := 'OUTPUT  '; IDTYPE := TEXTPTR; KLASS := VARS;
	VKIND := FORMAL; VLEV := 0; VADDR := 3
      END;
    ENTERID(OUTPUTPTR);
    NEW(CP,VARS);
    WITH CP^ DO
      BEGIN NAME := 'KEYBOARD'; IDTYPE := TEXTPTR; KLASS := VARS;
	VKIND := FORMAL; VLEV := 0; VADDR := 4
      END;
    ENTERID(CP);
    CP1 := NIL;
    FOR I := 0 TO 1 DO
      BEGIN NEW(CP,KONST);
	WITH CP^ DO
	  BEGIN IDTYPE := BOOLPTR;
	    IF I = 0 THEN NAME := 'FALSE   '
	    ELSE NAME := 'TRUE    ';
	    NEXT := CP1; VALUES.IVAL := I; KLASS := KONST
	  END;
	ENTERID(CP); CP1 := CP
      END;
    BOOLPTR^.FCONST := CP;
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN NAME := 'NIL     '; IDTYPE := NILPTR;
	NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST
      END;
    ENTERID(CP);
  END (*ENTSTDNAMES*) ;

  PROCEDURE ENTUNDECL;
  BEGIN
    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; KLASS := TYPES END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
	VALUES.IVAL := 0; KLASS := KONST
      END;
    NEW(UVARPTR,VARS);
    WITH UVARPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; VKIND := ACTUAL;
	NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS
      END;
    NEW(UFLDPTR,FIELD);
    WITH UFLDPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
	FLDADDR := 0; KLASS := FIELD
      END;
    NEW(UPRCPTR,PROC,DECLARED,ACTUAL);
    WITH UPRCPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; FORWDECL := FALSE;
	NEXT := NIL; INSCOPE := FALSE; LOCALLC := 0;
	PFLEV := 0; PFNAME := 0; PFSEG := 0;
	KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END;
    NEW(UFCTPTR,FUNC,DECLARED,ACTUAL);
    WITH UFCTPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
	FORWDECL := FALSE; INSCOPE := FALSE; LOCALLC := 0;
	PFLEV := 0; PFNAME := 0; PFSEG := 0;
	KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END
  END (*ENTUNDECL*) ;

  PROCEDURE ENTSPCPROCS;
    VAR LCP: CTP; I: INTEGER; ISFUNC: BOOLEAN;
	NA: ARRAY [1..42] OF ALPHA;
  BEGIN
    NA[ 1] := 'READ    '; NA[ 2] := 'READLN  '; NA[ 3] := 'WRITE   ';
    NA[ 4] := 'WRITELN '; NA[ 5] := 'EOF     '; NA[ 6] := 'EOLN    ';
    NA[ 7] := 'PRED    '; NA[ 8] := 'SUCC    '; NA[ 9] := 'ORD     ';
    NA[10] := 'SQR     '; NA[11] := 'ABS     '; NA[12] := 'NEW     ';
    NA[13] := 'UNITREAD'; NA[14] := 'UNITWRIT'; NA[15] := 'CONCAT  ';
    NA[16] := 'LENGTH  '; NA[17] := 'INSERT  '; NA[18] := 'DELETE  ';
    NA[19] := 'COPY    '; NA[20] := 'POS     '; NA[21] := 'MOVELEFT';
    NA[22] := 'MOVERIGH'; NA[23] := 'EXIT    '; NA[24] := 'IDSEARCH';
    NA[25] := 'TREESEAR'; NA[26] := 'TIME    '; NA[27] := 'FILLCHAR';
    NA[28] := 'OPENNEW '; NA[29] := 'OPENOLD '; NA[30] := 'OPENIO  ';
    NA[31] := 'CLOSE   '; NA[32] := 'SEEK    '; NA[33] := 'RESET   ';
    NA[34] := 'GET     '; NA[35] := 'PUT     '; NA[36] := 'SCAN    ';
    NA[37] := 'BLOCKREA'; NA[38] := 'BLOCKWRI'; NA[39] := 'DRAWLINE';
    NA[40] := 'PAGE    '; NA[41] := 'SIZEOF  '; NA[42] := 'DRAWBLOC';
    FOR I := 1 TO 42 DO
      BEGIN ISFUNC := I IN [5,6,7,8,9,10,11,15,16,19,20,25,36,37,38,41];
	IF ISFUNC THEN NEW(LCP,FUNC,SPECIAL)
	ELSE NEW(LCP,PROC,SPECIAL);
	WITH LCP^ DO
	  BEGIN NAME := NA[I]; NEXT := NIL; IDTYPE := NIL;
	    IF ISFUNC THEN KLASS := FUNC ELSE KLASS := PROC;
	    PFDECKIND := SPECIAL; KEY := I
	  END;
	ENTERID(LCP)
      END
    END (*ENTSPCPROCS*) ;

  PROCEDURE ENTSTDPROCS;
    VAR LCP,PARAM: CTP; LSP,FTYPE: STP; I: INTEGER; ISPROC: BOOLEAN;
	NA: ARRAY [1..19] OF ALPHA;
  BEGIN
    NA[ 1] := 'ODD     '; NA[ 2] := 'CHR     '; NA[ 3] := 'TRUNC   ';
    NA[ 4] := 'ROUND   '; NA[ 5] := 'SIN     '; NA[ 6] := 'COS     ';
    NA[ 7] := 'LOG     '; NA[ 8] := 'ATAN    '; NA[ 9] := 'LN      ';
    NA[10] := 'EXP     '; NA[11] := 'SQRT    '; NA[12] := 'MARK    ';
    NA[13] := 'RELEASE '; NA[14] := 'IORESULT'; NA[15] := 'UNITBUSY';
    NA[16] := 'PWROFTEN'; NA[17] := 'UNITWAIT'; NA[18] := 'UNITCLEA';
    NA[19] := 'HALT    ';
    FOR I := 1 TO 19 DO
      BEGIN ISPROC := I IN [12,13,17,18,19];
	CASE I OF
	  1:  BEGIN FTYPE := BOOLPTR; NEW(PARAM,VARS);
	      WITH PARAM^ DO
		BEGIN IDTYPE := INTPTR; VKIND := ACTUAL END;
	      END;
	  2:  FTYPE := CHARPTR;
	  3:  BEGIN FTYPE := INTPTR; NEW(PARAM,VARS);
	      WITH PARAM^ DO
		BEGIN IDTYPE := REALPTR; VKIND := ACTUAL END;
	      END;
	  5:  FTYPE := REALPTR;
	 12:  BEGIN FTYPE := NIL; NEW(PARAM,VARS); NEW(LSP,POINTER);
	      WITH LSP^ DO
		BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE := NIL END;
	      WITH PARAM^ DO
		BEGIN IDTYPE := LSP; VKIND := FORMAL END;
	      END;
	 14:  BEGIN FTYPE := INTPTR; PARAM := NIL END;
	 15:  BEGIN FTYPE := BOOLPTR; NEW(PARAM,VARS);
	      WITH PARAM^ DO
		BEGIN IDTYPE := INTPTR; VKIND := ACTUAL END;
	      END;
	 16:  FTYPE := REALPTR;
	 17:  FTYPE := NIL;
	 19:  BEGIN FTYPE := NIL; PARAM := NIL END
	END (*PARAM AND TYPE CASES*) ;
	IF ISPROC THEN NEW(LCP,PROC,STANDARD)
	ELSE NEW(LCP,FUNC,STANDARD);
	WITH LCP^ DO
	  BEGIN NAME := NA[I]; PFDECKIND := STANDARD; CSPNUM := I + 20;
	    IF ISPROC THEN KLASS := PROC ELSE KLASS := FUNC;
	    IF PARAM <> NIL THEN
	      WITH PARAM^ DO
		BEGIN KLASS := VARS; NEXT := NIL END;
	    IDTYPE := FTYPE; NEXT := PARAM
	  END;
	ENTERID(LCP)
      END
    END (*ENTSTDPROCS*) ;

  PROCEDURE INITSCALARS;
  BEGIN FWPTR := NIL; GLOBTESTP := NIL;
    LINESTART := 0; LINEINFO := LCAFTERMARKSTACK; LIST := FALSE;
    SYMBLK := 2; SCREENDOTS := 0; STARTDOTS := 0;
    FOR SEG := 0 TO MAXSEG DO
      WITH SEGTABLE[SEG] DO
	BEGIN DISKADDR := 0; CODELENG := 0; SEGNAME := '        ' END;
    LC := LCAFTERMARKSTACK; IOCHECK := TRUE; DP := TRUE;
    SEGINX := 0; NEXTJTAB := 1; NEXTPROC := 2; CURPROC := 1;
    NEW(SCONST); NEW(SYMBUFP); NEW(CODEP);
    SEG := 1; NEXTSEG := 10; CURBLK := 1; CURBYTE := 0;
    GOTOOK := FALSE; RANGECHECK := TRUE; SYSCOMP := FALSE;
    CODEINSEG := FALSE; PRTERR := TRUE; INCLUDING := FALSE
  END (*INITSCALARS*) ;

  PROCEDURE INITSETS;
  BEGIN
    CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];
    SIMPTYPEBEGSYS := [LPARENT] + CONSTBEGSYS;
    TYPEBEGSYS := [ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY]
		  + SIMPTYPEBEGSYS;
    TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
    BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY,PROGSY,BEGINSY];
    SELECTSYS := [ARROW,PERIOD,LBRACK];
    FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];
    STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,CASESY]
  END (*INITSETS*) ;

BEGIN (*COMPINIT*)
  INITSCALARS; INITSETS;
  LEVEL := 0; TOP := 0;
  WITH DISPLAY[0] DO
    BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END;
  ENTSTDTYPES;   ENTSTDNAMES;   ENTUNDECL;
  ENTSPCPROCS;   ENTSTDPROCS;
  GETNEXTPAGE;
  UNITWRITE(3,PROCTABLE[-1200],35);
  FOR IC := 1 TO 7 DO WRITELN(OUTPUT);
  WRITELN(OUTPUT,'PASCAL compilation');
  WRITE(OUTPUT,'<   0>');
  INSYMBOL;
  IF SYSCOMP THEN
    BEGIN OUTERBLOCK := NIL; SEG := 0; NEXTSEG := 1 END
  ELSE
    BEGIN TOP := 1; LEVEL := 1;
      WITH DISPLAY[1] DO
	BEGIN FNAME := NIL; FFILE := NIL;
	  FLABEL := NIL; OCCUR := BLCK
	END;
      LC := LC+2; (*KEEP STACK STRAIGHT FOR NOW*)
      NEW(OUTERBLOCK,PROC,DECLARED,ACTUAL);
      WITH OUTERBLOCK^ DO
	BEGIN NEXT := NIL; LOCALLC := LC;
	  NAME := 'PROGRAM '; IDTYPE := NIL; KLASS := PROC;
	  PFDECKIND := DECLARED; PFLEV := 0; PFNAME := 1; PFSEG := SEG;
	  PFKIND := ACTUAL; FORWDECL := FALSE; INSCOPE := TRUE
	END
    END;
  IF SY = PROGSY THEN
    BEGIN INSYMBOL;
      IF SY = IDENT THEN
	BEGIN SEGTABLE[SEG].SEGNAME := ID;
	  IF OUTERBLOCK <> NIL THEN OUTERBLOCK^.NAME := ID
	END
      ELSE ERROR(2); INSYMBOL;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
    END
END (*COMPINIT*) ;
